home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
opbonus.arc
/
MEGAPAGE.ARC
/
MEGAPAGE.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1991-03-20
|
23KB
|
720 lines
{ --------------------------------------------------------------------------
MEGAPAGE v1.00 - Copyright 1990 Scott Samet
FidoNet 1:135/990 CI$ 70671,213
--------------------------------------------------------------------------
This program enhances the TurboPower Software Object Professional POPHELP
screens. It adds the OPRO manual page numbers to the help screens, so
it's easier to look up the full information.
To run this program, you need the OPRO.TXT file, the various OPxxxxx.TXT
files, and the INDEX and INDEX2 files. All these files are provided with
OPRO. For my version of OPRO, they are located in INDEX.LZH on the BONUS
disk. The program will read these files and create updated files ending
with "NEW". None of the original files are altered.
It takes about 200k of available memory to run MEGAPAGE. A run time
error 203 indicates more memory is needed.
After running MEGAPAGE, execute "MAKEHELP OPRO.NEW" to compile the updated
files and create an enhanced OPRO.HLP file. Reload POPHELP so it uses the
new file.
-------------------------------------------------------------------------
Notes
By default, the program builds a list of identifers that appear in the
INDEX and INDEX2 files that do NOT appear in the help files. It creates
an extra help file, OPXXXXXX.NEW, for these identifiers. This information
is sketchy at best, but it is better than nothing, and does point you to
the correct place in the manual.
You may disable this feature by using the /N switch on the command line.
------------------------------------------------------------------------
Technical Description
The program reads the INDEX and INDEX2 files. For each index reference,
it creates a record on the heap, indexed by the identifier. If the
identifier is duplicated (like Init), the index entry is flagged to show
that duplicates exist. During this pass, an special index entry is made
for each unit and object name encountered.
The index files are read a second time. For identifiers flagged as
having duplicates, a second index entry is created. This time, the
identifier is qualified by the Object or Unit name, "RawWindow.Init".
Next, it reads the text of the entire help system. !TOPIC statements
are located and the topic extracted. If the topic does not match any
of the short identifiers, it is ignored. If it matches an unduplicated
short identifier, the volume and page information is added to the help
text.
If the topic matches a duplicated short identifier, like Init, it scans
the help text, searching for text that "looks like" the correct long
identifer. This is only a guess, but it's a fairly good one. If the
long identifer appears in the dictionary, the volume and page information
is added to the help text.
As dictionary entry is matched by a help topic, it's flagged to show
that it's been used.
After all the help text has been read, it makes one more pass over the
index files (unless the /N switch is present). Each item is checked
against the dictionary to see if it was used. Any item that was not used
is added to the special OPXXXXXX.NEW file.
The program has a hard-coded check so items from OPCOLOR are not written
to the OPXXXXXX. Since these items are (trivial) color names, like
RedOnBlack, there's no need to waste space on them.
-------------------------------------------------------------------------
Credit goes to Thom Foulks, Colorado Springs, for the original ADDPAGES
program that inspired MEGAPAGE.
-------------------------------------------------------------------------}
{$M 16384,150000,655360}
Uses
DOS, OPCrt, OPRoot, OPString;
Const
VirginNo = '1.01';
BuffSize = 16384;
Type
RefPtr = ^RefRec;
RefRec = Record
Volume: Char;
Page: Array [1..5] of Char;
Topic: Word;
End;
DeluxeStringDict = Object (StringDict)
Constructor InitCustom(PoolSize : Word);
end;
{ This constructor allocates the hash table to specified size, avoiding
heap fragmentation and delays caused by expanding on the fly. }
Constructor DeluxeStringDict.InitCustom(PoolSize : Word);
{-Allocate hash pool}
var
S : Word;
begin
sdUsed := 0;
sdPool := nil;
sdStatus := 0;
if not Root.Init then
Fail;
{Validate that PoolSize is a proper factor of two}
if (PoolSize > 8192) or (PoolSize < 8) then begin
Done;
InitStatus := epFatal+ecBadParam;
Fail;
end;
S := PoolSize;
while S > 1 do begin
if odd(S) then begin
Done;
InitStatus := epFatal+ecBadParam;
Fail;
end;
S := S shr 1;
end;
if not GetMemCheck(sdPool, PoolSize*SizeOf(StringPtr)) then begin
Done;
InitStatus := epFatal+ecOutOfMemory;
Fail;
end;
FillChar(sdPool^, PoolSize*SizeOf(StringPtr), 0);
sdSize := PoolSize;
end;
Var
Dict: DeluxeStringDict; {!!.01}
Bias: Word;
ShortCnt: Word;
LongCnt: Word;
ObjCnt: Word;
OrigMem: LongInt;
Procedure AllocTextBuff (Var F: Text; Size: LongInt);
Const
MaxSize = 65531;
Var
P: Pointer;
Begin
If Size > MaxSize
Then Size := MaxSize;
Size := Size and (Not 511);
If Size <= 0
Then Exit;
Getmem (P, Size);
If P = Nil
Then Exit;
SetTextBuf (F, P^, Size);
End;
Procedure FreeTextBuff (Var F: Text);
Begin
With TextRec (F) do
If BufPtr <> @Buffer
Then FreeMem (BufPtr, BufSize);
End;
Procedure Abort (S: String);
Begin
Writeln (S);
Halt (255);
End;
Procedure CheckOpen (FN: PathStr);
Begin
If InOutRes <> 0
Then Abort ('Unable to Open ' + FN + '; Error=' + Long2Str (IOResult));
End;
Procedure LogLineNo (S: String; Var N: Word; Force: Boolean);
Begin
If Force or (N = 1) or (N mod 100 = 0)
Then Write (N:10, ' ', S);
If Force
Then Writeln
Else Write (^M);
Inc (N);
end;
Procedure LoadRefs (FN1, FN2: PathStr);
Type
String31 = String[31];
String5 = String[5];
Var
CurrRef: RefPtr;
RefFile: Text;
Topic: String31;
ILine: String;
Pass: Word;
LineCnt: Word;
Function MakeRef (Vol: Char; Pg: String5): RefPtr;
Var
Ref: RefPtr;
Begin
New (Ref);
If Ref = Nil
Then RunError (203);
With Ref^ do Begin
Volume := Vol;
Move (Pg[1], Page, 5);
Topic := 0;
End;
MakeRef := Ref;
End { MakeRef };
Procedure TableRef (Vol: Char; Pg, Top, UnitName, ObjName: String31);
Var
Test: RefPtr;
I: Word;
Begin { TableRef }
Top := Trim (Top);
If Top = ''
Then Exit;
Pg := LeftPad (Trim (Pg), 6);
Delete (Pg, 3, 1);
ObjName := Trim (ObjName);
UnitName := Trim (UnitName);
If (ObjName = '') or (ObjName[1] = '-')
Then If (UnitName = '') or (UnitName[1] = '-')
Then Begin
ObjName := '';
UnitName := '';
End
Else Begin
ObjName := UnitName;
UnitName := '';
end;
If Pass = 1
Then Begin { First Pass }
{ Attempt to add to Short Dictionary }
If Dict.Member (Top, LongInt (Test))
Then If (Test <> Nil)
Then Begin
{ First Duplicate, Release RefRec }
Dispose (Test);
Dict.Update (Top, LongInt (Nil));
End
Else { Additional duplicate - nothing }
Else Begin
{ Unique reference - add to table }
Inc (ShortCnt);
Dict.Add (Top, LongInt (MakeRef (Vol, Pg)));
I := Dict.GetStatus;
If I = 10008
Then RunError (203);
If (0 < I) and (I < 20000)
Then Abort ('Unable to add ' + Top);
end;
{ Add Object Name to Short Dictionary }
If Not Dict.Member (ObjName, LongInt (Test))
Then begin
Dict.Add (ObjName, LongInt (MakeRef (' ', '')));
I := Dict.GetStatus;
If I = 10008
Then RunError (203);
If (0 < I) and (I < 20000)
Then Abort ('Unable to add ' + ObjName);
If I = 0
Then Inc (ObjCnt);
end;
end { First Pass }
Else Begin { Second Pass }
If (ObjName <> '') and (ObjName [1] <> '-')
Then If (Dict.Member (Top, LongInt (Test))) and (Test = Nil)
Then begin
{ Duplicate entries in short dictionary - create long entry }
Inc (LongCnt);
Dict.Add (ObjName + '.' + Top, LongInt (MakeRef (Vol, Pg)));
I := Dict.GetStatus;
If I = 10008
Then RunError (203);
If (0 < I) and (I < 20000)
Then Abort ('Unable to add ' + ObjName + '.' + Top);
end;
end { Second Pass };
End { TableRef };
Begin { LoadRefs }
ShortCnt := 0;
LongCnt := 0;
ObjCnt := 0;
Pass := 1;
Writeln;
Writeln ('Loading Identifiers:');
Assign (RefFile, FN1);
AllocTextBuff (RefFile, 2* BuffSize);
{$I-} Reset (RefFile); {$I+}
If IOResult <> 0
Then Abort ('Unable to open ' + FN1);
LineCnt := 1;
While Not Eof (RefFile) DO Begin
Readln (RefFile, ILine);
LogLineNo (FN1, LineCnt, False);
If ILine[1] = '{'
Then TableRef (ILine [2], Copy (ILine, 9, 6), Copy (ILine, 19, 28),
Copy (ILine, 47, 8), Copy (ILine, 57, 255));
End;
Close (RefFile);
FreeTextBuff (RefFile);
LogLineNo (FN1, LineCnt, True);
Assign (RefFile, FN2);
AllocTextBuff (RefFile, 2* BuffSize);
{$I-} Reset (RefFile); {$I+}
If IOResult <> 0
Then Abort ('Unable to open ' + FN2);
LineCnt := 1;
While Not Eof (RefFile) DO Begin
Readln (RefFile, ILine);
LogLineNo (FN2, LineCnt, False);
If ILine[1] = '{'
Then TableRef (ILine [2], Copy (ILine, 6, 6), Copy (ILine, 24, 28),
Copy (ILine, 52, 8), Copy (ILine, 62, 255));
End;
Close (RefFile);
FreeTextBuff (RefFile);
LogLineNo (FN2, LineCnt, True);
Pass := 2;
Writeln;
Writeln ('Loading non-unique identifiers:');
Assign (RefFile, FN1);
AllocTextBuff (RefFile, 2* BuffSize);
{$I-} Reset (RefFile); {$I+}
If IOResult <> 0
Then Abort ('Unable to open ' + FN1);
LineCnt := 1;
While Not Eof (RefFile) DO Begin
Readln (RefFile, ILine);
LogLineNo (FN1, LineCnt, False);
If ILine[1] = '{'
Then TableRef (ILine [2], Copy (ILine, 9, 6), Copy (ILine, 19, 28),
Copy (ILine, 47, 8), Copy (ILine, 57, 255));
End;
Close (RefFile);
FreeTextBuff (RefFile);
LogLineNo (FN1, LineCnt, True);
Assign (RefFile, FN2);
AllocTextBuff (RefFile, 2* BuffSize);
{$I-} Reset (RefFile); {$I+}
If IOResult <> 0
Then Abort ('Unable to open ' + FN2);
LineCnt := 1;
While Not Eof (RefFile) DO Begin
Readln (RefFile, ILine);
LogLineNo (FN2, LineCnt, False);
If ILine[1] = '{'
Then TableRef (ILine [2], Copy (ILine, 6, 6), Copy (ILine, 24, 28),
Copy (ILine, 52, 8), Copy (ILine, 62, 255));
End;
Close (RefFile);
FreeTextBuff (RefFile);
LogLineNo (FN2, LineCnt, True);
End { LoadRefs };
Function FormatReference (Ref: RefRec): String;
Var
P: String[6];
Begin
FormatReference := '';
With Ref do
If (Volume = '*')
Then FormatReference := ^M^J'Reference: Supplement'
Else If (Volume <> ' ')
Then Begin
P := Copy (Page, 3, 3);
While (Length (P) > 0) and (P[1] = '0') do Delete (P, 1, 1);
P := Copy (Page, 1, 2) + '-' + P;
If P[1] = ' '
Then Delete (P, 1, 1);
FormatReference := ^M^J'Reference: Vol ' + Volume + ', Pg ' + P;
end;
End;
Procedure ScanHelp (HelpFN, Ref1FN, Ref2FN: PathStr);
var
MaxTopic: Word;
MaxName: String[12];
SaveTopic: Word;
Procedure ScanFile (FNIn: PathStr; NestLvl: Word);
Var
IFile: Text;
OFile: Text;
ILine: String;
RefLine: String;
Temp: String;
ScanTop: String;
Match: RefPtr;
I: Word;
J: Word;
TopicNo: Word;
SaveTopic: Word;
FNOut: PathStr;
CmdLine: ^String;
LineNo: Word;
ShowFN: String[64];
Procedure DoFixups (FN1, FN2, FNOut: PathStr; Var MaxTopic: Word);
Type
String31 = String[31];
Var
Ref: RefPtr;
HFile: Text;
RefFile: Text;
Top: String [31];
ILine: String;
LineNo: Word;
Procedure CheckRef (Top, UnitName, ObjName, Class: String31);
Var
CurrRef: RefPtr;
TempRef: RefPtr;
Begin
Top := Trim (Top);
If Top = ''
Then Exit;
ObjName := Trim (ObjName);
UnitName := Trim (UnitName);
Class := Trim (Class);
If (ObjName = '') or (ObjName[1] = '-')
Then If (UnitName = '') or (UnitName[1] = '-')
Then Begin
ObjName := '';
UnitName := '';
End
Else Begin
ObjName := UnitName;
UnitName := '';
If Class = 'Method'
Then Class := 'Proc';
end;
{ Here we are quite arbitrary and throw away some things }
If (StUpCase (ObjName) = 'OPCOLOR')
Then Exit;
If Not Dict.Member (Top, LongInt (CurrRef))
Then CurrRef := Nil { not in short dictionary }
Else If CurrRef = Nil { in short dictionary, but duplicated }
Then If Not Dict.Member (Top, LongInt (CurrRef))
Then CurrRef := Nil; { not in long or short }
If CurrRef <> Nil
Then With CurrRef^ do
If Topic = 0
Then Begin
Class := Trim (Class);
Inc (MaxTopic);
Writeln (HFile, '!TOPIC ', MaxTopic, ' ', Top);
Writeln (HFile, '!NOINDEX');
Write (HFile, ^B);
If ObjName <> ''
Then If Dict.Member (ObjName, LongInt (TempRef)) and (TempRef <> NIL)
Then With TempRef^ do
Write (HFile, ^D, Topic, ^E, ObjName, ^E)
Else Write (HFile, ObjName);
Case Class[1] of
'D':
If Class = 'Direct'
Then Writeln (HFile, ' ', Top, ^B, ' (MAKEHELP Directive)')
Else Writeln (HFile, ' ', Top, ^B, ' (Conditional Define)');
'C':
Writeln (HFile, '.', Top, ^B,' (Constant)');
'T':
If Class = 'TConst'
Then Writeln (HFile, '.', Top, ^B, ' (Typed Constant)')
Else Writeln (HFile, '.', Top, ^B, ' (Type)');
'V':
Writeln (HFile, '.', Top, ^B, ' (Variable)');
'F':
Writeln (HFile, '.', Top, ^B, ' (Field)');
'E':
Writeln (HFile, '.', Top, ^B, ' (Enumerated Type element)');
'M':
Writeln (HFile, '.', Top, ^B, ' (Method)');
'P':
Writeln (HFile, '.', Top, ^B, ' (Procedure/Function)');
End;
If UnitName <> ''
Then Begin
Writeln (HFile);
Write (HFile, 'See also: ');
If Dict.Member (UnitName, LongInt (TempRef)) and (TempRef <> NIL)
Then With TempRef^ do
Writeln (HFile, ^D, Topic, ^E, UnitName, ^E)
Else Writeln (HFile, UnitName);
End;
Writeln (HFile, FormatReference (CurrRef^));
End;
End { CheckRef };
Begin { DoFixUps }
Writeln;
Writeln ('Building HELP text for missing items:');
Assign (HFile, FNOut);
AllocTextBuff (HFile, MaxAvail - 8192);
Rewrite (HFile);
Assign (RefFile, FN1);
AllocTextBuff (RefFile, MaxAvail);
{$I-} Reset (RefFile); {$I+}
CheckOpen (FN1);
LineNo := 1;
While Not Eof (RefFile) DO Begin
Readln (RefFile, ILine);
LogLineNo (FN1, LineNo, False);
If ILine[1] = '{'
Then CheckRef (Copy (ILine, 19, 28), Copy (ILine, 47, 8),
Copy (ILine, 57, 255), 'Method');
End;
Close (RefFile);
FreeTextBuff (RefFile);
LogLineNo (FN1, LineNo, True);
Assign (RefFile, FN2);
AllocTextBuff (RefFile, MaxAvail);
{$I-} Reset (RefFile); {$I+}
CheckOpen (FN2);
LineNo := 1;
While Not Eof (RefFile) DO Begin
Readln (RefFile, ILine);
LogLineNo (FN2, LineNo, False);
If ILine[1] = '{'
Then CheckRef (Copy (ILine, 24, 28), Copy (ILine, 52, 8),
Copy (ILine, 62, 255), Copy (ILine, 15, 8));
End;
Close (RefFile);
FreeTextBuff (RefFile);
Close (HFile);
FreeTextBuff (HFile);
LogLineNo (FN2, LineNo, True);
End { DoFixups };
Begin { ScanFile }
FNIn := FExpand (FNIn);
FNOut := JustPathName (FNIn) + '\' + JustName (FNIn) + '.NEW';
ShowFN := LeftPad (JustFileName (FNIn), 12) + ' -> ' + JustFileName (FNOut);
Assign (IFile, FNIn);
Assign (OFile, FNOut);
If NestLvl > 0
Then begin
AllocTextBuff (IFile, BuffSize);
AllocTextBuff (OFile, BuffSize);
end;
{$I-} Reset (IFile); {$I+}
CheckOpen (FNIn);
Rewrite (OFile);
CheckOpen (FNOut);
ScanTop := '';
RefLine := '';
SaveTopic := 0;
LineNo := 1;
While Not Eof (IFile) DO Begin
Readln (IFile, ILine);
LogLineNo (ShowFN, LineNo, False);
Temp := StUpCase (ILine);
If (ILine <> '') and (Temp[1] = ';')
Then Begin
If RefLine <> ''
Then Writeln (OFile, RefLine);
RefLine := '';
End;
If Copy (Temp, 1, 6) = '!BIAS '
Then Begin
Val (Trim (Copy (Temp, 6, 255)), I, J);
If J = 0
Then Bias := I;
End
Else If Copy (Temp, 1, 9) = '!INCLUDE '
Then Begin
Temp := Trim (Copy (Temp, 10, 255));
ILine := Copy (ILine, 1, 9) + JustPathName (Temp) + JustName (Temp) + '.NEW';
ScanFile (Temp, NestLvl + 1);
End
Else If Copy (Temp, 1, 7) = '!TOPIC '
Then Begin
If RefLine <> ''
Then Writeln (OFile, RefLine);
RefLine := '';
ScanTop := '';
Temp := Trim (Copy (ILine, 8, 255));
I := Pos (' ', Temp);
If I > 0
Then Begin
Val (Copy (Temp, 1, I - 1), TopicNo, J);
Inc (TopicNo, Bias);
If (J = 0) and (TopicNo > MaxTopic)
Then SaveTopic := TopicNo;
Temp := Trim (Copy (Temp, I, 255));
If Dict.Member (Temp, LongInt (Match))
Then If Match = Nil
Then ScanTop := '.' + StUpCase (Temp)
Else With Match^ do Begin
RefLine := FormatReference (Match^);
Topic := TopicNo;
ScanTop := '';
End;
End;
End
Else If (ScanTop <> '')
Then If (Pos (ScanTop, Temp) > 0)
Then begin
I := Pos (ScanTop, Temp);
J := I - 1;
If Temp [J] = ^E
Then Begin
Delete (Temp, J, 1);
Dec (J);
end;
While (J > 0) and (Temp [J] in ['A'..'Z', 'a'..'z', '0'..'9', '.']) do dec (J);
While (I <= Length (Temp)) and (Temp [I] in ['A'..'Z', 'a'..'z', '0'..'9', '.']) do Inc (I);
Temp := Copy (Temp, J + 1, I - J - 1);
If Dict.Member (Temp, LongInt (Match))
Then With Match^ do Begin
RefLine := FormatReference (Match^);
Topic := TopicNo;
ScanTop := '';
end;
end;
Writeln (OFile, ILine);
End;
If RefLine <> ''
Then Writeln (OFile, RefLine);
Close (IFile);
LogLineNo (ShowFN, LineNo, True);
FreeTextBuff (IFile);
If SaveTopic > MaxTopic
Then begin
MaxTopic := SaveTopic;
MaxName := JustName (FNIn);
end;
If NestLvl = 0
Then Begin
Writeln (OFile, '; Maximum Topic is really ', MaxTopic, ' in ', MaxName);
CmdLine := Ptr (PrefixSeg, $80);
If Pos ('/N', StUpCase (CmdLine^)) = 0
Then begin
SaveTopic := MaxTopic;
DoFixups (Ref1FN, Ref2FN, 'OPXXXXXX.NEW', MaxTopic);
Writeln (OFile, '!INCLUDE OPXXXXXX.NEW');
Writeln (OFile, '; Maximum Generated Topic is ', MaxTopic);
End;
Writeln;
Writeln ('Summary:');
Writeln (ShortCnt:10, ' Identifiers');
Writeln (LongCnt:10, ' Non-unique Identifers');
Writeln (ObjCnt:10, ' Objects and Methods');
Writeln (OrigMem - MaxAvail:10, ' Bytes used for identifiers');
Writeln (MaxAvail:10, ' Bytes left');
Writeln (SaveTopic:10, ' Maximum Input Topic Number (', MaxName, ')');
If Pos ('/N', StUpCase (CmdLine^)) = 0
Then Writeln (MaxTopic:10, ' Maximum Output Topic Number (OPXXXXXX)');
Writeln;
Writeln ('Run MAKEHELP ', JustFileName (FNOut), ' to update OPRO.HLP');
end;
Close (OFile);
FreeTextBuff (OFile);
End { ScanFile };
Begin { ScanHelp }
OrigMem := MaxAvail;
Dict.InitCustom (8192);
LoadRefs (Ref1FN, Ref2FN);
Bias := 0;
MaxTopic := 0;
MaxName := '';
Writeln;
Writeln ('Converting Help files:');
ScanFile (HelpFN, 0);
End { ScanHelp };
Begin
Writeln ('MEGAPAGE - V', VirginNo, ' - Add index information to TurboPower POPHELP files');
Writeln ('Copyright 1990, Scott Samet');
ScanHelp ('OPRO.TXT', 'INDEX', 'INDEX2');
End.